Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH11/SRC/OBJSOL1.CLS

Text File | 1996-03-26 | 8KB | 309 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ObjSolid"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

' These ObjPolygon objects are the oriented faces.
Public Faces As New Collection
Public Convex As Boolean
Public MaxZ As Single
' ***********************************************
' Clip faces.
' ***********************************************
Public Sub ClipEye(r As Single)
Dim obj As Object

    For Each obj In Faces
        obj.ClipEye r
    Next obj
End Sub


' ***********************************************
' Create faces to make a pyramid of height L with
' base given by the coord array.
' ***********************************************
Sub Stellate(L As Single, ParamArray coord() As Variant)
Dim x0 As Single
Dim y0 As Single
Dim z0 As Single
Dim x1 As Single
Dim y1 As Single
Dim z1 As Single
Dim x2 As Single
Dim y2 As Single
Dim z2 As Single
Dim x3 As Single
Dim y3 As Single
Dim z3 As Single
Dim Ax As Single
Dim Ay As Single
Dim Az As Single
Dim Bx As Single
Dim By As Single
Dim Bz As Single
Dim nx As Single
Dim ny As Single
Dim nz As Single
Dim num As Integer
Dim i As Integer
Dim pt As Integer

    num = (UBound(coord) + 1) \ 3
    If num < 3 Then
        Beep
        MsgBox "Must have at least 3 points to stellate.", , vbExclamation
        Exit Sub
    End If

    ' (x0, y0, z0) is the center of the polygon.
    x0 = 0
    y0 = 0
    z0 = 0
    pt = 0
    For i = 1 To num
        x0 = x0 + coord(pt)
        y0 = y0 + coord(pt + 1)
        z0 = z0 + coord(pt + 2)
        pt = pt + 3
    Next i
    x0 = x0 / num
    y0 = y0 / num
    z0 = z0 / num

    ' Find the normal.
    x1 = coord(0)
    y1 = coord(1)
    z1 = coord(2)
    x2 = coord(3)
    y2 = coord(4)
    z2 = coord(5)
    x3 = coord(6)
    y3 = coord(7)
    z3 = coord(8)
    Ax = x2 - x1
    Ay = y2 - y1
    Az = z2 - z1
    Bx = x3 - x2
    By = y3 - y2
    Bz = z3 - z2
    m3Cross nx, ny, nz, Ax, Ay, Az, Bx, By, Bz

    ' Give the normal length L.
    m3SizeVector L, nx, ny, nz

    ' The normal + <x0, y0, z0> gives the point.
    x0 = x0 + nx
    y0 = y0 + ny
    z0 = z0 + nz

    ' Build the triangles that make up the solid.
    x1 = coord(3 * num - 3)
    y1 = coord(3 * num - 2)
    z1 = coord(3 * num - 1)
    pt = 0
    For i = 1 To num
        x2 = coord(pt)
        y2 = coord(pt + 1)
        z2 = coord(pt + 2)
        AddFace x1, y1, z1, x2, y2, z2, x0, y0, z0
        x1 = x2
        y1 = y2
        z1 = z2
        pt = pt + 3
    Next i
End Sub

' ***********************************************
' Add an oriented face to the solid.
' ***********************************************
Public Sub AddFace(ParamArray coord() As Variant)
Dim pgon As ObjPolygon
Dim num As Integer
Dim pt As Integer
Dim i As Integer

    num = (UBound(coord) + 1) \ 3
    If num < 3 Then
        Beep
        MsgBox "Faces in a Solid must contain at least 3 points.", , vbExclamation
        Exit Sub
    End If

    Set pgon = New ObjPolygon
    Faces.Add pgon

    pt = 0
    For i = 1 To num
        pgon.AddPoint (coord(pt)), (coord(pt + 1)), (coord(pt + 2))
        pt = pt + 3
    Next i
End Sub

' ************************************************
' Perform backface removal on the faces.
' ************************************************
Public Sub Cull(X As Single, Y As Single, z As Single)
Dim obj As Object

    For Each obj In Faces
        obj.Cull X, Y, z
    Next obj
End Sub
' ***********************************************
' Create normals for polygon objects.
' ***********************************************
Sub CreateNormal(Objects As Collection)
Dim obj As Object

    For Each obj In Faces
        obj.CreateNormal Objects
    Next obj
End Sub

' ***********************************************
' Set or clear the Culled property for all faces.
' ***********************************************
Property Let Culled(value As Boolean)
Dim obj As Object

    For Each obj In Faces
        obj.Culled = value
    Next obj
End Property



' ***********************************************
' Return a string indicating the object type.
' ***********************************************
Property Get ObjectType() As String
    ObjectType = "SOLID"
End Property


' ************************************************
' Draw the object into a metafile.
' ************************************************
Public Sub MakeWMF(mhdc As Integer)
Dim obj As Object

    For Each obj In Faces
        obj.MakeWMF mhdc
    Next obj
End Sub

' ***********************************************
' Fix the data coordinates at their transformed
' values.
' ***********************************************
Public Sub FixPoints()
Dim obj As Object

    For Each obj In Faces
        obj.FixPoints
    Next obj
End Sub

' ************************************************
' Apply a transformation matrix which may not
' contain 0, 0, 0, 1 in the last column to the
' object.
' ************************************************
Public Sub ApplyFull(M() As Single)
Dim obj As Object

    For Each obj In Faces
        obj.ApplyFull M
    Next obj
End Sub

' ************************************************
' Apply a transformation matrix to the object.
' ************************************************
Public Sub Apply(M() As Single)
Dim obj As Object

    For Each obj In Faces
        obj.Apply M
    Next obj
End Sub


' ************************************************
' Apply a nonlinear transformation.
' ************************************************
Public Sub Distort(D As Object)
Dim obj As Object

    For Each obj In Faces
        obj.Distort D
    Next obj
End Sub

' ************************************************
' Write a polyline to a file using Write.
' Begin with "SOLID" to identify this object.
' ************************************************
Public Sub FileWrite(filenum As Integer)
Dim obj As Object

    Write #filenum, "SOLID", Convex, Faces.Count

    For Each obj In Faces
        obj.FileWrite filenum
    Next obj
End Sub


' ************************************************
' Draw the transformed solid on a Form, Printer,
' or PictureBox.
' ************************************************
Public Sub Draw(canvas As Object, Optional r As Variant)
Dim obj As Object

    For Each obj In Faces
        obj.Draw canvas, r
    Next obj
End Sub

' ************************************************
' Read a polyline from a file using Input.
' Assume the "SOLID" label has already been
' read.
' ************************************************
Public Sub FileInput(filenum As Integer)
Dim num As Integer
Dim i As Integer
Dim obj As Object
Dim obj_type As String

    ' Read the number of faces in the solid.
    Input #filenum, Convex, num

    ' Read faces from the file.
    For i = 1 To num
        Input #filenum, obj_type
        Select Case obj_type
            Case "SOLID"
                Set obj = New ObjSolid
            Case "POLYGON"
                Set obj = New ObjPolygon
            Case Else
                Beep
                MsgBox "Invalid Solid sub-object type """ & obj_type & """.", , vbExclamation
                Exit Sub
        End Select
        obj.FileInput filenum
        Faces.Add obj
    Next i
End Sub